home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostu2 / floor1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-12-01  |  6.0 KB  |  293 lines
  1. PROGRAM floor1;
  2. {
  3.   Floor of Doom, first life
  4.   - by Bjarke Viksφe
  5.   aug 1994
  6.  
  7.   Well, it does look nice. But let's face it, it's not Doom.
  8.   One could make a really nice game with this (Jazz JackRabbit ;) or
  9.   what about a rally game...
  10.   It uses a sort of ray-casting scheme everybody else seems to cherish
  11.   so much!
  12.  
  13.   Tilegraphics is 'coded'. Ofcourse I should have taken the time to draw
  14.   some really nice ones and used them, but I don't bother.
  15.   You should replace the 'CreateTiles' with a LoadPix() to load a .lbm pix
  16.   instead. By using all 256 colours cleverly you can even make triangles
  17.   or round tiles!
  18.  
  19.   Tiles are 32x32 pixels placed in a 256x256 buffer. 8x8=64 different tiles
  20.   in all. Map is 256x256 and consist of indexes to tiles ranging [0..63].
  21. }
  22.  
  23. {$A+,B-,G+,E+,I+,N-,X+}
  24. {$IFDEF DPMI}
  25. {$C FIXED PRELOAD PERMANENT}
  26. {$ENDIF}
  27.  
  28. USES
  29.     DEMOINIT,MOUSE;
  30.  
  31. {{$DEFINE DEBUG}
  32.  
  33. CONST
  34.     LINES = 70; {how many lines shall we paint}
  35.     TILT = 2; {tilt floor how much?}
  36.  
  37. TYPE
  38.     pBunk = ^BunkArray;
  39.     BunkArray = ARRAY[0..254, 0..255] of byte;
  40.     pArray = ^ArrayType;
  41.     ArrayType = ARRAY[0..32760] of integer;
  42.     LineArray = Array[0..LINES*4] of integer;
  43.  
  44. VAR
  45.     map, tiles : pBunk;
  46.     linetable : ^LineArray;
  47.     xpos,ypos : integer;
  48.  
  49.  
  50. (*------------------------------------------------*)
  51.  
  52. procedure SetColors;
  53. {Setup ugly, more or less randomly picked, colours}
  54. var
  55.     i : integer;
  56. begin
  57.     for i:=0 to 7 do setRGB(i, i,i,i);
  58.     for i:=8 to 15 do setRGB(i, (i-5)*2,0,0);
  59.     for i:=16 to 23 do setRGB(i, 0,(i-10)*2,(i-8)*2);
  60.     for i:=24 to 31 do setRGB(i, 0,0,42);
  61.     for i:=32 to 39 do setRGB(i, 0,(i-15)*2,0);
  62.     for i:=40 to 47 do setRGB(i, i,i,i);
  63.     for i:=48 to 55 do setRGB(i, i,0,0);
  64. end;
  65.  
  66.  
  67. procedure CreateMap;
  68. {Create map.
  69.  Characters in string are indexes to tiles! 'a' is tile #0,
  70.  'b' is #1 and so...}
  71.  
  72.  procedure Strip(ypos,xpos : integer; st : string);
  73.  var
  74.     j : integer;
  75.  begin
  76.         for j:=1 to length(st) do st[j]:=char(ord(st[j])-ord('a'));
  77.         Move(st[1],map^[ypos,xpos],length(st));
  78.  end;
  79.  
  80. var
  81.     i : integer;
  82. begin
  83.     GetMem(map,65535);
  84.     FillChar(map^,65535,#0);
  85.  
  86.     i:=20;
  87.     while i<60 do begin
  88.         Strip(i,30,'fgfgfgfgfgfgfgfgfgfg');
  89.         Strip(i+1,30,'gfgfgfgfgfgfgfgfgfgf');
  90.         if (i>35) AND (i<45) then begin Strip(i,39,'aaaaa'); Strip(i+1,39,'aaaaa'); end;
  91.         inc(i,2);
  92.     end;
  93.  
  94.     Strip(20,70,'bcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbc');
  95.     Strip(21,70,'cbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcb');
  96.     i:=22;
  97.     while (i<42) do begin
  98.         Strip(i,70,'bcaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabc');
  99.         Strip(i+1,70,'cbaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaacb');
  100.         Strip(i,60,'dedede');
  101.         Strip(i+1,60,'ededed');
  102.         inc(i,2)
  103.     end;
  104.     Strip(42,70,'bcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbc');
  105.     Strip(43,70,'cbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcb');
  106. end;
  107.  
  108. procedure CreateTiles;
  109. {Create some ugly tiles. We simple choose some colours and paint
  110.  a brick with them}
  111. var
  112.     i,j : integer;
  113. begin
  114.     GetMem(tiles,65535);
  115.     FillChar(tiles^,65535,#0);
  116.  
  117.     for i:=0 to 254 do {254, not 255, to get it running under DPMI!}
  118.         for j:=0 to 255 do
  119.             tiles^[i,j]:=((j DIV 32)*8) + random(8); {make dithered tile}
  120. end;
  121.  
  122.  
  123. procedure PrecalcLines;
  124. const
  125.     XPOS = 20;
  126. var
  127.     i,
  128.     x1,y1,x2,y2 : integer;
  129.     z : integer;
  130.     pos : word;
  131. begin
  132.     New(LineTable);
  133.     FillChar(LineTable^,SizeOf(LineArray),#0);
  134.  
  135.     z:=8000;
  136.     pos:=0;
  137.     for i:=1 to LINES do begin
  138.         x1:=(-XPOS * 65536) DIV z;
  139.         y1:=(i*TILT*65535) DIV z;
  140.         linetable^[pos]:=x1;
  141.         linetable^[pos+1]:=y1;
  142.  
  143.         x2:=(XPOS * 65535) DIV z;
  144.         linetable^[pos+2]:=(longint(x2-x1) SHL 11) DIV 160;
  145.         linetable^[pos+3]:=0;
  146.         inc(pos,4);
  147.  
  148.         inc(z,310);
  149.     end;
  150. end;
  151.  
  152.  
  153. procedure InitDemo;
  154. var
  155.     i : integer;
  156. begin
  157.     ClearWholeScreen;
  158.     SetColors;
  159.  
  160.     CreateMap;
  161.     CreateTiles;
  162.     PrecalcLines;
  163.  
  164.     xpos:=1200; ypos:=800;
  165. end;
  166.  
  167. procedure UninitDemo;
  168. var
  169.     i : integer;
  170. begin
  171.     FreeMem(map,65535);
  172.     FreeMem(tiles,65535);
  173.     Dispose(LineTable);
  174. end;
  175.  
  176.  
  177.  
  178. (*------------------------------------------------*)
  179.  
  180. procedure DrawFloor(x,y : integer); assembler;
  181. var
  182.     mappos,tablepos : word;
  183.     xadd : integer;
  184.     height, counts : word;
  185. asm
  186.     push    ds
  187.     mov    es,SEGA000
  188.     mov    di,100*320
  189.     mov    ax,WORD PTR [map+2]
  190.     {mov fs,ax} DB $8E,$E0
  191.     mov    ax,WORD PTR [linetable+2]
  192.     {mov gs,ax} DB $8E,$E8
  193.     mov    ax,WORD PTR [linetable]
  194.     mov    [tablepos],ax
  195.     mov    ds,WORD PTR [tiles+2]
  196.  
  197.     cld
  198.     mov    [height],LINES
  199. @y_run:
  200.  
  201.     mov    si,[tablepos]
  202.  
  203.     DB GS; mov    ax,[si+4]
  204.     mov    [xadd],ax
  205.  
  206.     DB GS; mov    dx,[si]
  207.     DB GS; mov    cx,[si+2]
  208.     add    dx,[x]
  209.     add    cx,[y]
  210.  
  211.     mov    bx,dx                    {Find first tile}
  212.     mov    ax,cx
  213.     shr    ax,5
  214.     shr    bx,5
  215.     mov    bh,al
  216.     mov    [mappos],bx
  217.     DB FS; mov al,[bx]        {get tile-index from map}
  218.     mov    ah,al                    {find map position in map-buffer}
  219.     and    al,7
  220.     shr    ah,3
  221.     shl    ax,5
  222.     mov    si,ax
  223.  
  224.     shl    dx,11
  225.     shl    cx,11
  226.     xor    dx,$8000
  227.     xor    cx,$8000
  228.  
  229.     mov    [counts],160
  230. @x_run:
  231.     mov    bh,dh        {get x-position of pixel}
  232.     mov    bl,ch        {get y-position of pixel}
  233.     shr    bx,3
  234.     and    bx,$1F1F
  235.     mov    al,[si+bx]    {get that pixel}
  236.     mov    ah,al
  237.     stosw                    {store it... well, we draw it twice to gain speed!}
  238.  
  239.     add    dx,[xadd]
  240.     jno    @noxadd
  241.     inc    [mappos]
  242.     mov    bx,[mappos]
  243.     DB FS; mov al,[bx]        {get new tile-index from map}
  244.     mov    ah,al                    {find tile position in tile-buffer}
  245.     and    al,7
  246.     shr    ah,3
  247.     shl    ax,5
  248.     mov    si,ax
  249. @noxadd:
  250.  
  251.     dec    [counts]
  252.     jnz    @x_run
  253.  
  254.     add    [tablepos],8
  255.     dec    [height]
  256.     jnz    @y_run
  257.  
  258.     pop    ds
  259. end;
  260.  
  261. (*------------------------------------------------*)
  262.  
  263. procedure RunOnce;
  264. var
  265.     x,y : integer;
  266. begin
  267.     VBLANK;
  268. {$IFDEF DEBUG}    SetRGB(0,20,0,0); {$ENDIF}
  269.  
  270.     ReadMouseMotionCounters(x,y);
  271.     inc(xpos,x);
  272.     inc(ypos,y);
  273.     if (xpos<200) then xpos:=200;
  274.     if (xpos>16384) then xpos:=16384;
  275.     if (ypos<200) then ypos:=200;
  276.     if (ypos>16384) then ypos:=16384;
  277.  
  278.     DrawFloor(xpos,ypos);
  279.  
  280. {$IFDEF DEBUG}    SetRGB(0,0,0,0); {$ENDIF}
  281. end;
  282.  
  283. begin
  284.     if NOT MouseDriverPresent then begin writeln('No mouse...'); halt; end;
  285.     InitMouse;
  286.  
  287.     SetScreenMode($13);
  288.     InitDemo;
  289.     repeat RunOnce until KeyPressed;
  290.     UninitDemo;
  291.     SetScreenMode(demoinit.TEXTMODE);
  292. end.
  293.